Analiza Danych - raport z projektu - silownia
Tomasz Adrych, Aleksandra Juchniewicz, Patrycja Karpicka
2025-01-25
Ten zestaw danych zapewnia szczegółowy przegląd rutynowych ćwiczeń członków siłowni, atrybutów fizycznych i wskaźników sprawności. Zawiera on 973 próbki danych z siłowni, w tym kluczowe wskaźniki wydajności, takie jak tętno, spalone kalorie i czas trwania treningu. Każdy wpis zawiera również dane demograficzne i poziomy doświadczenia, co pozwala na kompleksową analizę wzorców sprawności, postępów sportowców i trendów zdrowotnych.
1. Identyfikacja wartości brakujących
Po pierwsze zostały zidentyfikowane wartości brakujące. W przypadku zbioru danych siłownia, danych brakowało w kolumnach kolejno: Age, Workout Type oraz BMI (Body Mass Index). Do zobrazowania braków użyto pakietu VIS.
#Wczytanie pliku
silownia <- read_csv("silownia_new.csv")## Rows: 973 Columns: 15
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (2): Gender, Workout_Type
## dbl (13): Age, Weight (kg), Height (m), Max_BPM, Avg_BPM, Resting_BPM, Sessi...
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.tbl_df(silownia)## Warning: `tbl_df()` was deprecated in dplyr 1.0.0.
## ℹ Please use `tibble::as_tibble()` instead.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.## # A tibble: 973 × 15
## Age Gender `Weight (kg)` `Height (m)` Max_BPM Avg_BPM Resting_BPM
## <dbl> <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 NA Male 88.3 1.71 180 157 60
## 2 46 Female 74.9 1.53 179 151 66
## 3 32 Female 68.1 1.66 167 122 54
## 4 25 Male 53.2 1.7 190 164 56
## 5 38 Male 46.1 1.79 188 158 68
## 6 56 Female 58 1.68 168 156 74
## 7 36 Male 70.3 1.72 174 169 73
## 8 40 Female 69.7 1.51 189 141 64
## 9 28 Male 122. 1.94 185 127 52
## 10 28 Male 102. 1.84 169 136 64
## # ℹ 963 more rows
## # ℹ 8 more variables: `Session_Duration (hours)` <dbl>, Calories_Burned <dbl>,
## # Workout_Type <chr>, Fat_Percentage <dbl>, `Water_Intake (liters)` <dbl>,
## # `Workout_Frequency (days/week)` <dbl>, Experience_Level <dbl>, BMI <dbl>silownia <- janitor::clean_names(silownia)
#Liczba brakujących wartości w pliku, kolumnach i wierszach
sum(is.na(silownia))## [1] 400colSums(is.na(silownia))## age gender
## 100 0
## weight_kg height_m
## 0 0
## max_bpm avg_bpm
## 0 0
## resting_bpm session_duration_hours
## 0 0
## calories_burned workout_type
## 0 150
## fat_percentage water_intake_liters
## 0 0
## workout_frequency_days_week experience_level
## 0 0
## bmi
## 150rowSums(is.na(silownia))## [1] 2 1 1 0 0 0 0 0 0 0 1 0 0 0 1 0 0 0 0 0 1 0 0 2 0 0 0 0 0 0 0 1 1 0 0 1 0
## [38] 0 0 1 1 0 1 0 1 1 1 0 0 0 1 1 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 1 1 0 1 1 1 0
## [75] 1 0 0 1 0 1 0 1 0 0 0 0 1 1 0 0 1 1 0 0 0 0 1 0 2 1 0 0 0 0 0 1 0 0 0 0 0
## [112] 0 2 0 0 1 2 0 0 0 1 1 1 0 0 0 1 0 1 0 1 1 0 2 1 0 0 0 2 0 0 1 0 0 0 0 0 0
## [149] 1 0 1 0 0 0 1 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 1 0 0 0 0 0 0 0 1 0 0 0 1 1
## [186] 0 0 0 0 2 0 1 0 0 1 2 0 1 0 0 1 1 1 0 1 0 0 0 0 1 0 0 0 0 0 0 1 1 0 0 2 0
## [223] 0 0 0 0 0 0 0 1 0 0 1 0 0 1 0 1 0 1 0 0 0 0 0 1 2 0 0 1 0 1 0 1 0 0 0 0 0
## [260] 0 0 0 0 0 0 0 0 0 0 0 0 0 1 1 1 1 0 1 0 1 0 1 0 1 0 0 0 0 0 0 0 0 1 0 0 0
## [297] 1 1 1 1 0 1 2 0 0 0 0 0 0 0 0 1 0 1 2 0 0 0 0 0 0 1 0 0 1 1 0 0 0 0 0 0 1
## [334] 0 0 1 0 0 0 0 1 1 1 1 0 0 0 1 0 1 0 0 1 0 1 1 2 1 1 1 1 0 0 0 0 0 0 0 0 0
## [371] 0 1 2 0 0 0 0 0 0 2 1 0 0 0 0 1 2 0 1 0 1 1 0 0 2 1 0 1 0 1 0 1 1 0 0 1 0
## [408] 2 1 0 0 1 1 0 0 0 1 0 0 0 0 0 0 2 0 0 0 1 0 0 0 2 0 2 1 0 3 0 1 0 2 0 0 1
## [445] 0 0 0 1 1 1 0 0 0 0 0 0 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 2 1 0 0 1 0 0 2 0 1
## [482] 1 0 2 0 0 0 0 0 2 0 0 0 1 0 0 1 0 1 0 0 0 0 1 0 0 1 0 0 0 1 0 0 1 0 1 0 1
## [519] 0 0 0 1 0 0 0 0 0 0 0 0 0 0 1 0 0 0 0 0 1 1 0 0 0 1 0 0 1 0 0 1 0 0 0 0 0
## [556] 0 0 0 0 1 1 1 1 0 0 1 0 1 0 1 1 0 0 0 1 0 2 1 0 1 1 1 0 0 0 0 1 0 1 0 0 0
## [593] 0 0 0 1 0 1 1 0 0 1 1 0 0 1 1 1 1 1 0 1 0 1 0 1 0 2 0 0 0 0 1 1 0 0 1 0 0
## [630] 0 0 0 0 1 0 0 0 0 0 1 0 0 0 0 1 0 1 0 0 1 0 1 2 0 1 0 0 0 1 1 0 0 1 0 0 0
## [667] 1 0 0 0 0 1 0 0 0 1 0 0 0 0 0 2 0 0 1 1 1 1 0 0 3 0 0 0 0 1 0 1 0 2 0 2 0
## [704] 0 1 0 1 1 1 0 1 1 0 0 0 0 0 0 1 1 0 0 0 0 0 1 0 1 0 1 0 0 0 1 2 1 3 0 1 1
## [741] 2 0 0 0 0 1 0 2 0 0 0 0 1 1 0 0 0 0 0 0 0 0 1 2 1 1 1 0 0 0 0 0 1 0 1 0 0
## [778] 1 0 0 0 0 0 0 1 0 0 0 2 0 0 2 2 0 0 1 1 0 0 0 0 1 0 0 1 0 2 2 1 0 0 0 0 0
## [815] 0 0 0 0 2 0 1 0 1 0 0 0 1 0 0 0 0 0 0 0 0 0 1 1 0 0 0 0 1 0 0 0 0 1 1 1 1
## [852] 0 0 1 1 0 1 1 0 1 2 0 1 0 0 0 0 1 1 0 0 1 0 2 1 1 1 1 0 0 1 0 1 0 1 0 0 1
## [889] 0 1 0 1 0 0 0 0 0 0 1 0 1 0 2 0 0 0 0 0 1 1 2 2 0 0 0 0 0 0 2 0 0 1 0 0 0
## [926] 1 1 0 0 0 0 2 1 1 0 0 0 0 0 1 0 0 1 0 1 1 1 0 0 0 1 0 0 1 0 1 0 1 1 1 0 0
## [963] 2 0 1 1 0 0 0 1 2 1 0n_miss(silownia)## [1] 400#Wykresy brakujących wartości
vis_miss(silownia)
vis_miss(silownia, cluster=TRUE)
#Wykres powiązań pomiędzy zmiennymi, w których występują wartości NA
gg_miss_upset(silownia, nsets = 3)
#Wykresy częstości występowania brakujących zmiennych w zależności od płci i rodzaju ćwiczeń
gg_miss_var(silownia, facet = gender)
gg_miss_var(silownia, facet = workout_type)
2. Identyfikacja wartości odstających
Trzeci etap opierał się na zobrazowaniu wartości odstających. Za pomocą wykresów pudełkowych znaleziono wartości w odstające w kolumnach waga oraz spalone kalorie. Wartości te nie budzą większych zastrzeżeń, gdyż odchylenia w tego typu danych są normalne. Pozostałe wykresy pudełkowe nie rodzą wątpliwości.
boxplot(silownia$weight_kg, main = "silownia$weight_kg.")
boxplot(silownia$height_m, main = "silownia$height_kg.")
boxplot(silownia$max_bpm, main = "silownia$max_bpm")
boxplot(silownia$avg_bpm, main = "silownia$avg_bpm")
boxplot(silownia$resting_bpm, main = "silownia$resting_bpm")
boxplot(silownia$session_duration_hours, main = "silownia$session_duration_hours.")
boxplot(silownia$calories_burned, main = "silownia$calories_burned")
boxplot(silownia$fat_percentage, main = "silownia$fat_percentage")
boxplot(silownia$water_intake_liters, main = "silownia$water_intake_liters.")
boxplot(silownia$workout_frequency_days_week, main = "silownia$workout_frequency_days_week")
boxplot(silownia$experience_level, main = "silownia$experience_level")
3. Walidacje
Czwartym etapem projektu było opracowanie reguł walidacyjnych. Reguły opracowano dla każdej zmiennej wchodzącej w skład zbioru danych. W poniższym chunku zostały opisane oraz przedstawione w tabeli. Końcowa tabela zawiera informajcę czy reguły w poszczególnych zmiennych zostały spełnione. Wszystkie zmienne oprócz kolumny średnio tętno spełniły wskazane reguły. W przypadku średniego tętna nie ma powdów do zmieniania danych, gdyż tętno ludzkie charakteryzuje się dużymi odchyleniami i może różnić się w zależności od innych zmiennych takich jak: masa ciała, intensywność treningu etc.
validate_silownia <- function(silownia) {
silownia %>%
mutate(
age_valid = ifelse(is.na(age) | (age >= 18 & age <= 100), TRUE, FALSE),
gender_valid = ifelse(gender %in% c("Male", "Female"), TRUE, FALSE),
weight_valid = ifelse(weight_kg > 35 & weight_kg <= 200, TRUE, FALSE),
height_valid = ifelse(height_m >= 1 & height_m <= 2.5, TRUE, FALSE),
max_bpm_valid = ifelse(max_bpm >= 30 & max_bpm <= 220, TRUE, FALSE),
avg_bpm_valid = ifelse(avg_bpm <= max_bpm & avg_bpm > resting_bpm, TRUE, FALSE),
resting_bpm_valid = ifelse(resting_bpm >= 30 & resting_bpm <= 100, TRUE, FALSE),
session_duration_valid = ifelse(session_duration_hours > 0 & session_duration_hours <= 12, TRUE, FALSE),
calories_burned_valid = ifelse(calories_burned > 0, TRUE, FALSE),
workout_type_valid = ifelse(is.na(workout_type) | workout_type %in% c("Yoga", "Cardio", "Strength", "HIIT"), TRUE, FALSE),
fat_percentage_valid = ifelse(fat_percentage >= 6 & fat_percentage <= 100, TRUE, FALSE),
water_intake_valid = ifelse(water_intake_liters >= 0.5 & water_intake_liters <= 5, TRUE, FALSE),
workout_frequency_valid = ifelse(workout_frequency_days_week >= 0 & workout_frequency_days_week <= 7, TRUE, FALSE),
experience_level_valid = ifelse(experience_level >= 1 & experience_level <= 3, TRUE, FALSE),
bmi_valid = ifelse(is.na(bmi) | (bmi > 10 & bmi <= 50), TRUE, FALSE)
)
}
# Zastosowanie reguł walidacyjnych
validated_silownia <- validate_silownia(silownia)
# Sprawdzenie
validation_summary <- validated_silownia %>%
summarise(
age_valid = all(age_valid),
gender_valid = all(gender_valid),
weight_valid = all(weight_valid),
height_valid = all(height_valid),
max_bpm_valid = all(max_bpm_valid),
avg_bpm_valid = all(avg_bpm_valid),
resting_bpm_valid = all(resting_bpm_valid),
session_duration_valid = all(session_duration_valid),
calories_burned_valid = all(calories_burned_valid),
workout_type_valid = all(workout_type_valid),
fat_percentage_valid = all(fat_percentage_valid),
water_intake_valid = all(water_intake_valid),
workout_frequency_valid = all(workout_frequency_valid),
experience_level_valid = all(experience_level_valid),
bmi_valid = all(bmi_valid)
)
# Zobrazowanie
print(validation_summary)## # A tibble: 1 × 15
## age_valid gender_valid weight_valid height_valid max_bpm_valid avg_bpm_valid
## <lgl> <lgl> <lgl> <lgl> <lgl> <lgl>
## 1 TRUE TRUE TRUE TRUE TRUE FALSE
## # ℹ 9 more variables: resting_bpm_valid <lgl>, session_duration_valid <lgl>,
## # calories_burned_valid <lgl>, workout_type_valid <lgl>,
## # fat_percentage_valid <lgl>, water_intake_valid <lgl>,
## # workout_frequency_valid <lgl>, experience_level_valid <lgl>,
## # bmi_valid <lgl>4. Imputacje
Piąty etap raportu opierał się na uzupełnieniu wartości brakujących w trzech kolumnach wskazanych w w etapie drugim. Do uzupełnienia braków w kolumnie age, użyto metody RPART (Recursive Partitioning and Regression Trees). W przypadku kolumny BMI braki uzupełniono. za pomocą wzoru: Waga / Wzrost^2.
#Imputacja NA dla zmiennej Age
age1 <- round (imputate_na(silownia, age, gender, method = "rpart"))
summary(age1)## * Impute missing values based on Recursive Partitioning and Regression Trees
## - method : rpart
##
## * Information of Imputation (before vs after)
## Original Imputation
## described_variables "value" "value"
## n "873" "973"
## na "100" " 0"
## mean "38.62658" "38.64543"
## sd "12.27346" "11.87576"
## se_mean "0.4153938" "0.3807193"
## IQR "22" "20"
## skewness "-0.07665477" "-0.08224593"
## kurtosis "-1.229667" "-1.161305"
## p00 "18" "18"
## p01 "18" "18"
## p05 "19" "19"
## p10 "21" "22"
## p20 "25.0" "26.4"
## p25 "28" "29"
## p30 "30" "30"
## p40 "35" "35"
## p50 "39" "40"
## p60 "43" "43"
## p70 "47" "47"
## p75 "50" "49"
## p80 "51" "51"
## p90 "55" "54"
## p95 "57" "57"
## p99 "59" "59"
## p100 "59" "59"plot(age1)
silownia <- replace_na(data.frame(silownia, age1))
silownia <- silownia %>%
mutate(age = age1) %>%
select(-age1)
#Imputacja NA dla zmiennej BMI
silownia <- silownia %>%
mutate(
bmi = if_else(
is.na(bmi),
silownia$weight_kg / (silownia$height_m^2),
bmi
)
)
# zaokrąglam do 2 miejsc po przecinku
silownia <- silownia %>%
mutate(bmi = round(bmi, 2))
#Imputacja NA dla zmiennej Workout_Type
#Zamiana zmiennych tekstowych na numeryczne
#Zmienna Gender: 0 oznacza mężczyznę, 1 kobietę
#Zmienna Workout_Type: 1 to trening siłowy, 2 to trening HIIT, 3 to cardio, a 4 oznacza yogę
silownia$gender <- ifelse (silownia$gender == "Male", 0,
ifelse(silownia$gender == "Female", 1, 2))
silownia$workout_type <- ifelse (silownia$workout_type == "Strength", 1,
ifelse(silownia$workout_type == "HIIT", 2,
ifelse(silownia$workout_type == "Cardio", 3,
ifelse(silownia$workout_type == "Yoga", 4, 5))))
#Dane do obliczeń; bez zmiennych Agei i BMI zawierających braki
robocze <- silownia[, 1:15]
#Zmienna Workout_type jako factor
robocze$workout_type <- as.factor(robocze$workout_type)
#####################################################
#Wielowymiarowe wypełnianie przez równania łańcuchowe
#Tworzenie macierzy zmiennych wykorzystywanych do imputacji
#Wybór zmiennej Workout_type jako tej, która ma zostać uzupełniona
wybrana_zmienna <- is.na(robocze)
#Imputacja danych
wynik <- mice(robocze, where = wybrana_zmienna)##
## iter imp variable
## 1 1 workout_type
## 1 2 workout_type
## 1 3 workout_type
## 1 4 workout_type
## 1 5 workout_type
## 2 1 workout_type
## 2 2 workout_type
## 2 3 workout_type
## 2 4 workout_type
## 2 5 workout_type
## 3 1 workout_type
## 3 2 workout_type
## 3 3 workout_type
## 3 4 workout_type
## 3 5 workout_type
## 4 1 workout_type
## 4 2 workout_type
## 4 3 workout_type
## 4 4 workout_type
## 4 5 workout_type
## 5 1 workout_type
## 5 2 workout_type
## 5 3 workout_type
## 5 4 workout_type
## 5 5 workout_type#Podstawienie uzupełnionej zmiennej do zbioru danych
silownia <- complete(wynik)5. Wizualizacje
Szósty etap zawiera wizualizacje najistoniejszych danych z obszaru wydajności oraz efektywności treningów. Do opracowania wizualizacji użyto pakietów plotly oraz ggplot2.
# Zobrazowanie za pomocą wykresów pudełkowych, liczby spalonych kalorii w zależności od wykonywanego treningu
wykres1 <- ggplot(data = silownia, aes(x = workout_type, y = calories_burned)) +
geom_boxplot() +
coord_flip() +
ggtitle("Zależność między typem treningu a liczbą spalonych kalorii") +
xlab("Typ treningu") +
ylab("Spalone kalorie") +
theme_light()
plotly::ggplotly(wykres1)#Krzywa gęstości BMI
wykres2 <- ggplot(silownia, aes(x = bmi)) +
geom_density(fill ="blue") +
ggtitle("Krzywa gęstości BMI") +
xlab("Body mass index") +
ylab("Gęstość")
plotly::ggplotly(wykres2)#Rozkład BMI i udziału tłuszczu w masie ciała według wieku
wykres3 <- ggplot(silownia, aes(x = age, y = bmi, color = fat_percentage )) +
geom_point() +
ggtitle("Rozkład BMI i udziału tłuszczu w masie ciała według wieku") +
xlab("Wiek") +
ylab("Body mass index")
plotly::ggplotly(wykres3)# Zależność między wiekiem a BMI z podziałem na płeć
ggplot(silownia, aes(x = age, y = bmi, color = gender)) +
geom_point(size = 3) +
geom_smooth(method = "lm", se = FALSE) +
labs(
title = "Zależność między wiekiem a BMI",
x = "Wiek",
y = "BMI"
) +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'## Warning: The following aesthetics were dropped during statistical transformation:
## colour.
## ℹ This can happen when ggplot fails to infer the correct grouping structure in
## the data.
## ℹ Did you forget to specify a `group` aesthetic or to convert a numerical
## variable into a factor?
# Średnia liczba spalonych kalorii w zależności od typu teningu
# Grupowanie danych i obliczenie średnich
avg_calories <- aggregate(calories_burned ~ workout_type, data = silownia, mean)
# Wykres słupkowy
ggplot(avg_calories, aes(x = workout_type, y = calories_burned, fill = workout_type)) +
geom_bar(stat = "identity") +
geom_text(aes(label = round(calories_burned, 1)), vjust = -0.5, size = 5) + # Dodanie liczb nad słupkami
labs(
title = "Średnia liczba spalonych kalorii w zależności od typu treningu",
x = "Typ treningu",
y = "Średnie spalone kalorie"
) +
theme_minimal() +
scale_fill_brewer(palette = "Set2")
# Spożycie wody w zależności od poziomu doświadczenia
ggplot(silownia, aes(x = factor(experience_level, labels = c("Beginner", "Intermediate", "Advanced")),
y = water_intake_liters, fill = factor(experience_level))) +
geom_boxplot(outlier.color = "red", outlier.size = 3) +
geom_jitter(width = 0.2, aes(color = workout_frequency_days_week), size = 3, alpha = 0.7) +
labs(
title = "Spożycie wody w zależności od poziomu doświadczenia",
x = "Poziom doświadczenia",
y = "Spożycie wody (litry)",
color = "Częstotliwość treningów (dni/tydzień)"
) +
scale_fill_brewer(palette = "Pastel1") +
theme_minimal()
# Wykres spalonych kalorii do wagi
ggplot(silownia, aes(x = weight_kg, y = calories_burned, color = factor(experience_level))) +
geom_point(size = 4, alpha = 0.8) +
geom_smooth(method = "lm", se = FALSE, linetype = "dashed", color = "black") +
labs(
title = "Zależność spalonych kalorii od wagi",
x = "Waga (kg)",
y = "Spalone kalorie",
color = "Poziom doświadczenia"
) +
scale_color_brewer(palette = "Set1") +
theme_minimal()## `geom_smooth()` using formula = 'y ~ x'
6. Statystyki opisowe oraz korelacja
W ramach siódmego etapu sporządzono statysyki opisowe w tabeli dla zmiennych ilościowych. Obliczono między innymi: średnią, odchylenie standardowe, kwantyle, wariancję, współczynnik zmiennośći, skośność oraz kurtozę. Ponad to obliczono korelacje pomiędzy zmiennymi oraz sporządzono macierz,aby łatwiej zobrazować wyniki.
# Sporządzenie tabeli zawierającej statysytki opisowe
Statystki <- numSummary(
data.frame(silownia$age, silownia$weight_kg, silownia$height_m, silownia$max_bpm, silownia$avg_bpm, silownia$resting_bpm, silownia$session_duration_hours, silownia$calories_burned, silownia$fat_percentage, silownia$water_intake_liters, silownia$bmi),
statistics = c("mean","sd", "quantiles", "se(mean)", "var", "CV", "IQR", "skewness", "kurtosis"),
quantiles = c(.25, .50, .75))
print(Statystki)## mean sd se(mean) var
## silownia.age 38.645427 11.8757574 0.380719303 1.410336e+02
## silownia.weight_kg 73.854676 21.2075005 0.679881252 4.497581e+02
## silownia.height_m 1.722580 0.1277199 0.004094512 1.631237e-02
## silownia.max_bpm 179.883864 11.5256860 0.369496528 1.328414e+02
## silownia.avg_bpm 143.766701 14.3451014 0.459882839 2.057819e+02
## silownia.resting_bpm 62.223022 7.3270599 0.234894757 5.368581e+01
## silownia.session_duration_hours 1.256423 0.3430335 0.010997148 1.176720e-01
## silownia.calories_burned 905.422405 272.6415165 8.740485739 7.433340e+04
## silownia.fat_percentage 24.976773 6.2594188 0.200667755 3.918032e+01
## silownia.water_intake_liters 2.626619 0.6001719 0.019240629 3.602064e-01
## silownia.bmi 24.912127 6.6608794 0.213537990 4.436731e+01
## IQR CV skewness kurtosis
## silownia.age 20.00 0.30730046 -0.08224593 -1.16130547
## silownia.weight_kg 27.90 0.28715176 0.77238400 -0.02396899
## silownia.height_m 0.18 0.07414455 0.33885837 -0.72363267
## silownia.max_bpm 20.00 0.06407293 -0.03795049 -1.18791555
## silownia.avg_bpm 25.00 0.09978042 0.08636096 -1.19872361
## silownia.resting_bpm 12.00 0.11775481 -0.07163590 -1.18146572
## silownia.session_duration_hours 0.42 0.27302378 0.02576103 -0.35080519
## silownia.calories_burned 356.00 0.30112080 0.27832110 -0.05604995
## silownia.fat_percentage 8.00 0.25060959 -0.63522468 -0.33901946
## silownia.water_intake_liters 0.90 0.22849603 0.07147990 -1.02029786
## silownia.bmi 8.45 0.26737497 0.76364786 0.74324036
## 25% 50% 75% n
## silownia.age 29.00 40.00 49.00 973
## silownia.weight_kg 58.10 70.00 86.00 973
## silownia.height_m 1.62 1.71 1.80 973
## silownia.max_bpm 170.00 180.00 190.00 973
## silownia.avg_bpm 131.00 143.00 156.00 973
## silownia.resting_bpm 56.00 62.00 68.00 973
## silownia.session_duration_hours 1.04 1.26 1.46 973
## silownia.calories_burned 720.00 893.00 1076.00 973
## silownia.fat_percentage 21.30 26.20 29.30 973
## silownia.water_intake_liters 2.20 2.60 3.10 973
## silownia.bmi 20.11 24.16 28.56 973# Obliczenie wybranych korelacji pomiędzy zmiennymi
silownia[, "workout_type"] <- as.numeric(silownia[, "workout_type"])
macierz_korelacji <- round(cor(silownia[,1:15]),2)
print(macierz_korelacji)## age gender weight_kg height_m max_bpm avg_bpm
## age 1.00 -0.02 -0.04 -0.03 -0.02 0.03
## gender -0.02 1.00 -0.58 -0.58 -0.01 -0.01
## weight_kg -0.04 -0.58 1.00 0.37 0.06 0.01
## height_m -0.03 -0.58 0.37 1.00 -0.02 -0.01
## max_bpm -0.02 -0.01 0.06 -0.02 1.00 -0.04
## avg_bpm 0.03 -0.01 0.01 -0.01 -0.04 1.00
## resting_bpm 0.00 -0.01 -0.03 -0.01 0.04 0.06
## session_duration_hours -0.01 0.01 -0.01 -0.01 0.01 0.02
## calories_burned -0.14 -0.15 0.10 0.09 0.00 0.34
## workout_type 0.02 -0.02 0.00 0.02 0.05 -0.03
## fat_percentage 0.00 0.41 -0.23 -0.24 -0.01 -0.01
## water_intake_liters 0.03 -0.67 0.39 0.39 0.03 0.00
## workout_frequency_days_week 0.01 0.02 -0.01 -0.01 -0.03 -0.01
## experience_level -0.01 0.00 0.00 -0.01 0.00 0.00
## bmi -0.02 -0.31 0.85 -0.16 0.07 0.02
## resting_bpm session_duration_hours calories_burned
## age 0.00 -0.01 -0.14
## gender -0.01 0.01 -0.15
## weight_kg -0.03 -0.01 0.10
## height_m -0.01 -0.01 0.09
## max_bpm 0.04 0.01 0.00
## avg_bpm 0.06 0.02 0.34
## resting_bpm 1.00 -0.02 0.02
## session_duration_hours -0.02 1.00 0.91
## calories_burned 0.02 0.91 1.00
## workout_type -0.02 0.02 0.00
## fat_percentage -0.02 -0.58 -0.60
## water_intake_liters 0.01 0.28 0.36
## workout_frequency_days_week -0.01 0.64 0.58
## experience_level 0.00 0.76 0.69
## bmi -0.03 -0.01 0.06
## workout_type fat_percentage water_intake_liters
## age 0.02 0.00 0.03
## gender -0.02 0.41 -0.67
## weight_kg 0.00 -0.23 0.39
## height_m 0.02 -0.24 0.39
## max_bpm 0.05 -0.01 0.03
## avg_bpm -0.03 -0.01 0.00
## resting_bpm -0.02 -0.02 0.01
## session_duration_hours 0.02 -0.58 0.28
## calories_burned 0.00 -0.60 0.36
## workout_type 1.00 -0.05 0.05
## fat_percentage -0.05 1.00 -0.59
## water_intake_liters 0.05 -0.59 1.00
## workout_frequency_days_week 0.01 -0.54 0.24
## experience_level 0.05 -0.65 0.30
## bmi -0.01 -0.12 0.21
## workout_frequency_days_week experience_level bmi
## age 0.01 -0.01 -0.02
## gender 0.02 0.00 -0.31
## weight_kg -0.01 0.00 0.85
## height_m -0.01 -0.01 -0.16
## max_bpm -0.03 0.00 0.07
## avg_bpm -0.01 0.00 0.02
## resting_bpm -0.01 0.00 -0.03
## session_duration_hours 0.64 0.76 -0.01
## calories_burned 0.58 0.69 0.06
## workout_type 0.01 0.05 -0.01
## fat_percentage -0.54 -0.65 -0.12
## water_intake_liters 0.24 0.30 0.21
## workout_frequency_days_week 1.00 0.84 0.00
## experience_level 0.84 1.00 0.02
## bmi 0.00 0.02 1.00# Wizualizacja maciery korelacji
corrplot(macierz_korelacji, method = "color", type = "upper", order = "hclust",
tl.col = "black", tl.srt = 45)
7. Wnioskowanie statystyczne
Ostatni etap analizy zawiera liniowy model regresji wielorakiej w ramach, którego przeprowadzono testy T-studenta, test współliniowości, test Shapiro-Wilka, zinterpretowano miary dopasowania R^2 oraz AIC. Dodatkowo sporządzono wykresy reszt modelu oraz zinterpretowano współczynniki przy zmiennych objaśniających. Na koniec przeprowadzono testy istotności t-studenta pomiędzy: typem treningu a liczbą spalonych kalorii oraz płcią a BMI.
# Model liniowej regresji wielorakiej objaśniający zależności między spalonymi kaloriam a czasem trwania trenigu, BMI, procentem tkanki tłuszczowej oraz średnim tętnem podczas treningu
model <- lm(calories_burned ~ session_duration_hours + bmi + fat_percentage + avg_bpm, data = silownia)
summary(model)##
## Call:
## lm(formula = calories_burned ~ session_duration_hours + bmi +
## fat_percentage + avg_bpm, data = silownia)
##
## Residuals:
## Min 1Q Median 3Q Max
## -192.849 -50.682 1.092 43.647 215.474
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -768.0301 29.7697 -25.799 < 2e-16 ***
## session_duration_hours 672.9051 7.7262 87.094 < 2e-16 ***
## bmi 1.9091 0.3261 5.855 6.54e-09 ***
## fat_percentage -4.2402 0.4264 -9.944 < 2e-16 ***
## avg_bpm 6.1652 0.1497 41.190 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 66.92 on 968 degrees of freedom
## Multiple R-squared: 0.94, Adjusted R-squared: 0.9398
## F-statistic: 3792 on 4 and 968 DF, p-value: < 2.2e-16# Test t-studenta dla zmiennych objaśnianych modelu
# Ho: Współczynnik przy zmiennej nie różni się istotnie od zera
# Ha: Współcznnik przy zmiennej różni się istotnie od zera
#W przypadku wszystkich zmiennych p-value dla t-studenta jest mniejsze od poziomu Alfa. Odrzucamy hipotezę zerową w wyniku czego wszystkie zmienne różnią się istotnie od zera.
#Interpretacje
#Session_duration_hours: Wzrost czasu trawania sesji o 1 godzinę średnio powoduje wzrost liczby spalonych kalori o 672.91 kcal ceteris paribus
#BMI: Wzrost BMI o jedną jednostkę średnio powoduje wzrost liczby spalonych kalori o 1.9 kcal ceteris paribus
#Fat_Percentage: Wzrost tkanki tłuszczowej o 1 punkt procentowy średnio powoduje spadek liczby spalonych kalorii o 4,24 kcal ceteris paribus.
#Avg_BPM: Wzrost średniego tętna podczas treningu o 1 jednostkę średnio powoduje wzrost liczby spalonych kalori ceteris paribus.
#R^2 = 94%, Zmienne wchodzące w skład modelu objaśniły jego zmienność w 94%. Model jest bardzo dobrze dopasowania
AIC(model) #AIC = 10948.12. Model jest dobrze dopasowany.## [1] 10948.12#Wykres reszt z modelu
plot(model$residuals)
#Testowanie współliniowości
vif(model)## session_duration_hours bmi fat_percentage
## 1.524807 1.023962 1.546372
## avg_bpm
## 1.000762# VIF 1: Brak współliniowości. Zmienna nie jest skorelowana z innymi zmiennymi.
# 1 < VIF < 5: Umiarkowana współliniowość. Zmienna jest w pewnym stopniu skorelowana z innymi zmiennymi,
# VIF 5: Wysoka współliniowość. Zmienna jest silnie skorelowana z innymi zmiennymi, co może prowadzić
#Wszystkie zmienne w modelu przyjmują wartości nieznacznie większe od 1. Oznacza to, iż mamy doczynienia z brakiem wspólinowości więc zmienne nie są skorelowane z innymi zmiennymi.
# Test normlaności rozkładu Shapiro-Wilka
shapiro.test(model$residuals)##
## Shapiro-Wilk normality test
##
## data: model$residuals
## W = 0.99776, p-value = 0.2146#Ho: Reszty pochodzą z populacji o rozkładzie normlanym
#Ha: Reszty nie pochodzą z populacji o rozkładzie normalnym
#P-value = 0,2146, Brak podstaw do odrzucenia hipotezy zerowej, reszy pochodzą z populacji o rozkładzie normlanym.
#################################################
#Zależność między typem treningu a liczbą spalonych kalorii
# Ho: Brak różnic między typem treningów a liczbą spalonych kalorii
# Ha : Są istotne różnice między typem treningów a liczbą spalonych kalorii
ggbetweenstats(
data = silownia,
x = workout_type,
y = calories_burned,
title = "Sprawdzenie zależności między typem treningu a liczbą spalonych kalorii"
)
# p-value > 0,05 oznacza, iż nie ma statystycznie istotnych różnic między typem treningu a liczbą spalonych kalorii.
################################
# Porównanie BMI względem płci
# Ho: Brak istotnych statystycznie różnic między płcią a BMI
# Ha : Występują istotne statystycznie róznice między płcią a BMI
ggbetweenstats(
data = silownia,
x = gender,
y = bmi,
title = "Porównianie BMI w zależności płci"
)
# p-value < 0,05. Odrzucamy hipotezę zerową, a więc są statystycznie istotne różnice między płcią a BMI.8. Podsumowanie
W całym raporcie przeprowadziliśmy kolejno data Wrangling (w tym, wstępną analizę danych, czyszczenie danych, zindetfyikowanie wartości brakujących oraz odstających, imputację danych oraz przygotowanie danych do wizualizacji), wizulizację danych. W kolejnym etapie zostały przedstawione najważniejsze statysyki opisowe wszystkich zmiennych wchodzących w skład naszego zbioru danych. Ponadto stworzyliśmy macierz korelacji, aby lepiej zwiuzalizować zależności pomiędzy poszczególynymi zmiennymi. W ramach ostatniego etapu sporządziliśmy liniowy model regresji wielorakiej za pomocą, którego wyjasniliśmy jak na liczbę spalonych kalorii wpływają zmienne: czas trwania sesji treningowej, BMI oraz procent tkanki tłuszczowej. Model okazał się bardzo dobrze dopasowany oraz istotny statysycznie. Normalność rozkładu reszt sprawdziliśmy za pomocą testu Shapiro-Wilka. Ponad to udowodniliśmy za pomocą testów t, iż typ treningu nie wpływa istotnie na liczbę spalonych kalorii oraz sprawdziliśmy, że BMI istotnie różni się między płciami.